Workbench Add-On/Workbench Add-On - Volume 1.iso/Dev/SmallTalk/mstcomp.c

C/C++ Source or Header | 1995-08-25 | 83KB | 3,079 lines

/***********************************************************************
 *
 *    Byte code compiler.
 *
 ***********************************************************************/

/***********************************************************************
 *
 * Copyright (C) 1990, 1991, 1992 Free Software Foundation, Inc.
 * Written by Steve Byrne.
 *
 * This file is part of GNU Smalltalk.
 *
 * GNU Smalltalk is free software; you can redistribute it and/or modify it
 * under the terms of the GNU General Public License as published by the Free
 * Software Foundation; either version 1, or (at your option) any later
 * version.
 *
 * GNU Smalltalk is distributed in the hope that it will be useful, but WITHOUT
 * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
 * FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
 * more details.
 *
 * You should have received a copy of the GNU General Public License along with
 * GNU Smalltalk; see the file COPYING.  If not, write to the Free Software
 * Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
 *
 ***********************************************************************/


/*
 *    Change Log
 * ============================================================================
 * Author      Date       Change
 * sbb         19 Apr 91      Added skipCompilation boolean, for conditional
 *              compilation.
 *
 * sbb         16 Feb 91      Recursive calls to equalConstant had the arguments
 *              reversed.
 *
 * sbb         26 Nov 90      Fixed whileTrue: and whileFalse: to loop only if the
 *              value returned by the receiver is the expected one,
 *              instead of if it's the boolean not of the expected
 *              value.
 *
 * sbb         10 Nov 90      Added support for retaining the latest compiled
 *              method so the interpreter can return it from the
 *              compile: primitive.
 *
 * sbb         21 Sep 90      Fixed so that a block that contains no statements
 *              properly returns nil.
 *
 * sbyrne    20 May 90      Improved error handling...compiler errors set a flag,
 *              and execution does not occur if the expression to be
 *              executed has compilation errors.
 *
 * sbyrne    16 May 90      Added usage of emacsProcess.
 *
 * sbyrne    20 Apr 90      Fixed compiler to reset the byte code system before
 *              using it.  The problem was if an error occurred, the
 *              old byte code stream was still in use, and further
 *              compilations were losing in a big way.
 *
 * sbyrne    25 Mar 90      Changed cache hit ratio reporting to check for divide
 *              by zero, and to cast the byte counter to double (it
 *              was casting to float and relying on promotion).
 *
 * sbyrne    13 Jan 90      Added support for "thisContext" as a compiler
 *              built-in variable.
 *
 * sbyrne    28 Dec 89      Compiled methods now record their exact number of
 *              byte codes.  Previously, if the byte codes didn't
 *              exactly fill to a word-boundary, there was no way to
 *              distinguish that case.  Now, with the advent of
 *              dumping byte codes from within Smalltalk, this has
 *              become a necessity.
 *
 * sbyrne    27 Dec 89      Realloc literal vec wasn't reallocing in units of
 *              sizeof(OOP), so after a while, the literal vector
 *              wasn't big enough.  Typically most methods don't have
 *              a lot of literals, so this was not a problem.
 *
 * sbyrne     2 Oct 89      Fixed a bug with compilation of cascaded messages.
 *              see HACK ALERT below.
 *
 * sbyrne    21 Sep 89      Made compilation of methods from strings record the
 *              source string.
 *
 * sbyrne    13 Sep 89      Various changes for garbage collector.
 *
 * sbyrne     2 Sep 89      Began adding support for the method descriptor
 *              instance variable.
 *
 * sbyrne     2 Jan 89      I guess it should be stated somewhere: you'll notice
 *              in the code that there are several places where I
 *              could have taken a more "functional" (i.e. LISP
 *              oriented call a function within a function call)
 *              approach.  I chose not to because it can make
 *              debugging easier, it doesn't slow down the code much,
 *              and may help the reader to understand better what's
 *              going on in the code.
 *
 * sbyrne     1 Jan 89      Created.
 *
 */


#include "mst.h"
#include "mstsym.h"
#include "mstcomp.h"
#include "msttree.h"
#include "mstbyte.h"
#include "mstdict.h"
#include "mstoop.h"
#include "mstinterp.h"
#include "mstlex.h"
#include <setjmp.h>
#ifdef HAS_ALLOCA_H
#include <alloca.h>
#endif
#ifdef old_code /* Sun Jan 27 00:35:00 1991 */
/**/#include <sys/time.h>
/**/#if defined(USG)
/**/#include <sys/times.h>
/**/#endif
#endif /* old_code Sun Jan 27 00:35:00 1991 */
#ifdef sun
#include <sys/time.h>
#include <sys/resource.h>
#endif

#define LITERAL_VEC_CHUNK_SIZE        32

extern    long        cacheHits, cacheMisses;

typedef enum {
  falseJump,
  trueJump,
  unconditionalJump
} JumpType;

typedef enum {
  methodContext,
  blockContext
} ContextType;

typedef struct CompiledMethodStruct *CompiledMethod;

typedef struct MethodInfoStruct {
  OBJ_HEADER;
  OOP        sourceCode;
  OOP        category;
} *MethodInfo;

typedef struct FileSegmentStruct {
  OBJ_HEADER;
  OOP        fileName;
  OOP        startPos;
  OOP        length;
} *FileSegment;

/* These hold the compiler's notions of the current class for compilations,
 * and the current category that compiled methods are to be placed into */
OOP            thisClass, thisCategory;

/* This holds the CompiledMethod oop for the most recently compiled method.
 * It is only really valid after a compile: has been done, but this is
 * the only place that its used. */
OOP            latestCompiledMethod;

/* These flags control whether byte codes are printed after compilation,
 * and whether regression testing is in effect (which causes any messages
 * that the system prints out to become constant messages, i.e. no timing
 * information is printed) */
Boolean            declareTracing, regressionTesting;

/* If true, the normal execution information is supressed, and the prompt
 * is emitted with a special marker character ahead of it to let the process
 * filter know that the execution has completed. */
Boolean                   emacsProcess = false;

/* If true, the compilation of a set of methods will be skipped completely;
 * only syntax will be checked.  Set by primitive, cleared by grammar.
 */
Boolean            skipCompilation = false;

static Boolean        hasExtendedSuper, isSuper(), equalConstant(),
            compileWhileLoop(), compileIfStatement(),
            compileIfTrueFalseStatement(), compileAndOrStatement();
static OOP        computeSelector(), makeConstantOOP(),
            getMethodLiterals(), makeNewMethod(), methodNew(),
            methodInfoNew(), fileSegmentNew();
static ByteCodes    optimizeByteCodes(), compileSubExpression(),
            compileSubExpressionWithGoto(),
            compileDefaultValue();
static int        computeLocationIndex(), isSpecialVariable(),
            addConstant(), addSelector(), whichBuiltinSelector(),
            addForcedSelector(), listLength(), addLiteral();
static CompiledMethod    simpleMethodNew();
static void         compileStatement(), compileExpression(),
            compileSimpleExpression(), compileVariable(),
            compileConstant(), compileBlock(),
            compileStatements(), compileUnaryExpr(),
            compileBinaryExpr(), compileKeywordExpr(),
            compileSend(), compileCascadedMessage(),
            compileAssignments(), addMethodClassVariable(),
            compileJump(), compileKeywordList(),
            initLiteralVec(), reallocLiteralVec(),
            compileBlockArguments(), installMethod();

/* Used to abort really losing compiles, jumps back to the top level of the
 * compiler */
static jmp_buf        badMethod;

/* The vector of literals that the compiler uses to accumulate literal
 * constants into */
static OOP        *literalVec;

/* These indicate the current number of literals in the method being compiled
 * and the current maximum allocated size of the literal vector */
static int        numLiterals, literalVecMax;

/* HACK ALERT!! HACK ALERT!!  This variable is used for cascading.  The
 * tree structure is all wrong for the code in cascade processing to find
 * the receiver of the initial message.  What this does is when it's true,
 * compileUnaryExpr, compileBinaryExpr, and compileKeywordExpr record
 * its value, and clear the global (to prevent propagation to compilation
 * of subnodes).  After compiling their receiver, if the saved value of
 * the flag is true, they emit a dupStackTop, and continue compilation.
 * Since cascaded sends are relatively rare, I figured that this was a better
 * alternative than passing useless parameters around all the time.
 */
static Boolean        dupMessageReceiver = false;

/*
 *    void installInitialMethods()
 *
 * Description
 *
 *    This routine does a very interesting thing.  It installs the inital
 *    method, which is the primitive for "methodsFor:".  It does this by
 *    creating a string that contains the method definition and then passing
 *    this to the parser as an expression to be parsed and compiled.  Once
 *    this has been installed, we can go ahead and begin loading the rest of
 *    the Smalltalk method definitions, but until the "methodsFor:" method is
 *    defined, we cannot begin to deal with
 *    "!Object methodsFor: 'primitives'!".
 *
 */
void installInitialMethods()
{
  char        *methodsForString;

  initDefaultCompilationEnvironment();

  methodsForString = "\
methodsFor: aCategoryString \
    <primitive: 150> \
";
  initLexer(true);        /* tell the lexer we're doing internal
                   compiles */

  pushSmalltalkString(stringNew(methodsForString));
  yyparse();
  popStream(false);        /* can't close a string! */
}

/*
 *    void initDefaultCompilationEnvironment()
 *
 * Description
 *
 *    Does what it says.
 *
 */
void initDefaultCompilationEnvironment()
{
  setCompilationClass(behaviorClass);
  setCompilationCategory(nilOOP);
}

/*
 *    void invokeInitBlocks()
 *
 * Description
 *
 *    This function will send a message to Smalltalk (the system dictionary)
 *    asking it to invoke a set of initialization blocks.  There are methods
 *    in Smalltalk that allow for the recording of blocks to be invoked after
 *    image load, and this function sets that process in motion.
 *
 */
void invokeInitBlocks()
{
  /* +++ this will eventually be replaced with the user-level callin */
  prepareExecutionEnvironment();
  pushOOP(smalltalkDictionary);
  sendMessage(internString("doInits"), 0, false);
  interpret();
  finishExecutionEnvironment();
}

/*
 *    void setCompilationClass(classOOP)
 *
 * Description
 *
 *    Sets the compiler's notion of the class to compile methods into.
 *
 * Inputs
 *
 *    classOOP:
 *        An OOP for a Class object to compile method definitions into.
 *
 */
void setCompilationClass(classOOP)
OOP    classOOP;
{
  maybeMoveOOP(classOOP);
  thisClass = classOOP;
}

/*
 *    void setCompilationCategory(categoryOOP)
 *
 * Description
 *
 *    Sets the compiler's notion of the current method category
 *
 * Inputs
 *
 *    categoryOOP:
 *        An OOP that indicates the category to be used.  Typically a
 *        string.
 *
 */
void setCompilationCategory(categoryOOP)
OOP    categoryOOP;
{
  maybeMoveOOP(categoryOOP);
  thisCategory = categoryOOP;
}

/*
 *    void copyCompileContext()
 *
 * Description
 *
 *    Called only during a GC flip, this routine copies the current
 *    compilation context variables to new space, since they're part of the
 *    "root set".
 *
 */
void copyCompileContext()
{
  if (!isNil(thisClass)) {
    localMaybeMoveOOP(thisClass);
  }

  if (!isNil(thisCategory)) {
    localMaybeMoveOOP(thisCategory);
  }
}

/*
 *    void executeStatements(temporaries, statements, quiet)
 *
 * Description
 *
 *    Called to compile and execute an "immediate expression"; i.e. a set of
 *    Smalltalk statements that are not part of a method definition.
 *
 * Inputs
 *
 *    temporaries:
 *        Syntax tree node that represents the temporary variables
 *        associated with the expression.
 *    statements:
 *        The statements of the expression.  A syntax tree node.
 *    quiet : Flag to indicate either messages are to be output indicating
 *        the commencement of execution and some timing results at the
 *        end of execution.
 *
 */
void executeStatements(temporaries, statements, quiet)
TreeNode temporaries, statements;
Boolean    quiet;
{
  TreeNode    messagePattern;
  unsigned long startTime, endTime, deltaTime;
#ifdef old_code /* Sat Jan  5 12:18:29 1991 */
/**/#if !defined(USG)
/**/  struct timeval startTime, endTime, deltaTime;
/**/#else
/**/  time_t startTime, endTime, deltaTime;
/**/  struct tms dummy;
/**/#endif
#endif /* old_code Sat Jan  5 12:18:29 1991 */
#ifdef sun
  struct rusage startRusage, endRusage;
#endif
  OOP        returnedValue;

  setCompilationClass(objectClass);

  messagePattern = makeUnaryExpr(nil, "executeStatements");
  compileMethod(makeMethod(messagePattern, temporaries, 0, statements), false);
  if (hadError) {        /* don't execute on error */
    return;
  }

  /* send a message to NIL, which will find this synthetic method definition
     in Object and execute it */
/* dprintf("==============> ExecuteStatements\n"); */
  prepareExecutionEnvironment();
/* printContext(); */
  pushOOP(nilOOP);
  if (!quiet) {
    printf("\nExecution begins...\n");
  }
  sendMessage(internString("executeStatements"), 0, false);
  byteCodeCounter = 0;
  startTime = getMilliTime();
#ifdef sun
  getrusage(RUSAGE_SELF, &startRusage);
#endif
  interpret();
#ifdef sun
  getrusage(RUSAGE_SELF, &endRusage);
#endif
  endTime = getMilliTime();
#ifdef old_code /* Sat Jan  5 12:19:10 1991 */
/**/#if !defined(USG)
/**/  gettimeofday(&startTime, nil);
/**/  interpret();
/**/  gettimeofday(&endTime, nil);
/**/#else
/**/  startTime = times(&dummy);
/**/  interpret();
/**/  endTime = times(&dummy);
/**/#endif
#endif /* old_code Sat Jan  5 12:19:10 1991 */
  returnedValue = finishExecutionEnvironment();
  if (!quiet) {
    if (!regressionTesting) {
      printf("%d byte codes executed\n", byteCodeCounter);
      deltaTime = endTime - startTime;
      if (deltaTime <= 0) {
     deltaTime = 1;        /* it could be zero which would core dump */
      }
      printf("which took %d.%03d seconds, giving %f bytecodes/sec\n",
         deltaTime/1000, deltaTime%1000, (float)byteCodeCounter/
         (deltaTime / 1000.0));
#ifdef sun
      deltaTime = ((endRusage.ru_utime.tv_sec * 1000) +
                  (endRusage.ru_utime.tv_usec / 1000)) -
          ((startRusage.ru_utime.tv_sec * 1000) +
          (startRusage.ru_utime.tv_usec / 1000));
      printf("(%d.%03d seconds user time, giving %f bytecodes/sec)\n",
         deltaTime/1000, deltaTime%1000, (float)byteCodeCounter/
         (deltaTime / 1000.0));
      deltaTime = ((endRusage.ru_stime.tv_sec * 1000) +
                  (endRusage.ru_stime.tv_usec / 1000)) -
          ((startRusage.ru_stime.tv_sec * 1000) +
          (startRusage.ru_stime.tv_usec / 1000));
      printf("(%d.%03d seconds system time)\n",
         deltaTime/1000, deltaTime%1000);
      printf("(%d swaps, %d minor page faults, %d major page faults)\n",
             endRusage.ru_nswap - startRusage.ru_nswap,
             endRusage.ru_minflt - startRusage.ru_minflt,
             endRusage.ru_majflt - startRusage.ru_majflt);
  printf("(%d voluntary context switches, %d involuntary context switches)\n",
          endRusage.ru_nvcsw - startRusage.ru_nvcsw,
          endRusage.ru_nivcsw - startRusage.ru_nivcsw);
#endif

#ifdef old_code /* Sat Jan  5 12:20:57 1991 */
/**/#if !defined(USG)
/**/      deltaTime.tv_sec = endTime.tv_sec - startTime.tv_sec;
/**/      deltaTime.tv_usec = endTime.tv_usec - startTime.tv_usec;
/**/      if (deltaTime.tv_usec < 0) {
/**/    deltaTime.tv_sec--;
/**/    deltaTime.tv_usec += 1000000;
/**/      }
/**/      if (deltaTime.tv_sec == 0 && deltaTime.tv_usec == 0) {
/**/    deltaTime.tv_usec = 1;    /* fake a non-zero amount of time */
/**/      }
/**/      printf("which took %d.%d seconds, giving %f bytecodes/sec\n",
/**/         deltaTime.tv_sec, deltaTime.tv_usec, (double)byteCodeCounter/
/**/         (deltaTime.tv_sec + deltaTime.tv_usec/1000000.0));
/**/#else
/**/      deltaTime = endTime - startTime;
/**/      if (deltaTime <= 0){
/**/     deltaTime = 1;        /* it could be zero which would core dump */
/**/      }
/**/      printf("which took %d.%d seconds, giving %f bytecodes/sec\n",
/**/         deltaTime/gethz(), deltaTime%gethz(), (float)byteCodeCounter/
/**/         (deltaTime / (double) gethz()));
/**/#endif
#endif /* old_code Sat Jan  5 12:20:57 1991 */
      if (cacheHits + cacheMisses) {
    printf("%d cache hits, %d misses %f hit ratio\n",
           cacheHits, cacheMisses,
           (float)cacheHits / (cacheHits + cacheMisses));
      } else {
    printf("%d cache hits, %d misses\n",
           cacheHits, cacheMisses);
      }

{
  extern long numMethods, numBlocks;
  extern long totalMethods, totalRealized;
   printf("Methods %d blocks %d, percentage %.2f\n",
      numMethods, numBlocks, numBlocks * 100.0 / numMethods);
  printf("Methods that weren't real: %d, %.2f%% of total\n", totalMethods,
     totalMethods * 100.0 / numMethods);
  printf("Average realized value %.4f, total %d\n", (float)totalRealized / numBlocks,
     totalRealized);
}

/*    approx 25% of byte codes are sends
      printf("sends / bytecodes = %.1f\n",
         (cacheHits + cacheMisses) * 100.0 / byteCodeCounter );
*/
#ifdef countingByteCodes
      printByteCodeCounts();
#endif
#ifdef collision_checking
      { int i;
    extern int collide[];
    for (i = 0; i < 2048; i++) {
      if (collide[i]) {
        printf("collide[%d] = %d\n", i, collide[i]);
      }
    }
      }
#endif /* collision_checking */
    }

    printf("returned value is ");
    printObject(returnedValue);
    printf("\n");
  }
}


/*
 *    void compileMethod(method)
 *
 * Description
 *
 *    Compile the code for a complete method definition.  Special cases for
 *    methods that don't return a value explicitly by returning "self".
 *    Actually creates the CompiledMethod object and installs it in the
 *    current method dictionary with the selector derived from the method
 *    expression.
 *
 * Inputs
 *
 *    method: A syntax tree node for a method definition.
 *
 */
void compileMethod(method)
TreeNode method;
{
  TreeNode    statement;
  OOP        selector;
  ByteCodes    byteCodes;

  dupMessageReceiver = false;
  latestCompiledMethod = nilOOP;

  initCompiler();
  declareArguments(method->vMethod.selectorExpr);
  declareTemporaries(method->vMethod.temporaries);

  if (setjmp(badMethod) == 0) {
    for (statement = method->vMethod.statements; statement;
     statement = statement->vExpr.expression) {
      compileStatement(statement->vExpr.receiver);
      if (statement->vExpr.receiver->nodeType != returnExprType) {
    if (statement->vExpr.expression == nil) {
      /* compile a return of self */
      compileByte(returnIndexed | receiverIndex);
    } else {
      /* ignore the result of the last statement if it's not used */
      compileByte(popStackTop);
    }
      }
    }

    if (method->vMethod.statements == nil) {
      /* special case an empty statement body to return self */
      /* ??? this could compile some kind of primitive failure message,
     I guess */
      compileByte(returnIndexed | receiverIndex);
    }

    if (hasExtendedSuper) {
      addMethodClassVariable();
    }

    selector = computeSelector(method->vMethod.selectorExpr);
    byteCodes = getByteCodes();
    byteCodes = optimizeByteCodes(byteCodes);

    installMethod(selector, method->vMethod.primitiveIndex,
          getArgCount(), getTempCount(),
          getMethodLiterals(), byteCodes);
  } else {
    hadError = true;
  }

  undeclareTemporaries(method->vMethod.temporaries);
  undeclareArguments(method->vMethod.selectorExpr);
  freeTree(method);
}

/*
 *    static void compileStatement(stmt)
 *
 * Description
 *
 *    Compiles a statement expression, including return expressions.
 *
 * Inputs
 *
 *    stmt  : A stmt tree node.
 *
 */
static void compileStatement(stmt)
TreeNode stmt;
{
  int        index;

  switch (stmt->nodeType) {
  case constExprType:
  case blockNodeType:
    index = -1;
    break;

  default:
    index = isSpecialVariable(stmt->vExpr.receiver);
  }

  if (index < 0) {
    if (stmt->nodeType == returnExprType) {
      compileExpression(stmt->vExpr.receiver);
      compileByte(returnMethodStackTop);
    } else {
      compileExpression(stmt);
    }
  } else {
    if (stmt->nodeType == returnExprType) {
      /* return one of {self, true, false, nil} */
      compileByte(returnIndexed | index);
    } else {
      compileExpression(stmt);
    }
  }
}

/*
 *    static void compileExpression(expr)
 *
 * Description
 *
 *    Compile an arbitrary expression, including an assignment expression.
 *
 * Inputs
 *
 *    expr  : A syntax tree node for an expression, including assignments.
 *
 */
static void compileExpression(expr)
TreeNode expr;
{
  if (expr->nodeType == assignExprType) {
    compileSimpleExpression(expr->vExpr.expression);
    compileAssignments(expr->vExpr.receiver);
  } else {
    compileSimpleExpression(expr);
  }
}

/*
 *    static void compileSimpleExpression(expr)
 *
 * Description
 *
 *    The basic expression compiler.  Can be called recursively.  Dispatches
 *    based on the type of the expression to different routines that
 *    specialize in compilations for that expression.
 *
 * Inputs
 *
 *    expr  : A syntax tree node for some kind of expression.
 *
 */
static void compileSimpleExpression(expr)
TreeNode expr;
{
  switch (expr->nodeType) {
  case variableNodeType:
    compileVariable(expr);
    break;
  case constExprType:
    compileConstant(expr);
    break;
  case blockNodeType:
    compileBlock(expr);
    break;
  case unaryExprType:
    compileUnaryExpr(expr);
    break;
  case binaryExprType:
    compileBinaryExpr(expr);
    break;
  case keywordExprType:
    compileKeywordExpr(expr);
    break;
  case cascadedMessageNodeType:
    compileCascadedMessage(expr);
    break;
  default:
    compileExpression(expr);
  }
}

/*
 *    static void compileVariable(varName)
 *
 * Description
 *
 *    Compile code to push the value of a variable onto the stack.  The
 *    special variables, self, true, false, super, and thisContext, are
 *    handled specially.  For other variables, different code is emitted
 *    depending on where the variable lives, such as in a global variable or
 *    in a method temporary.
 *
 * Inputs
 *
 *    varName:
 *        A syntax tree node that indicates a variable name.
 *
 */
static void compileVariable(varName)
TreeNode varName;
{
  SymbolEntry    variable;
  int        index, location;

  index = isSpecialVariable(varName);
  if (index >= 0) {
    compileByte(pushSpecial | index);
    return;
  }

  if (internString(varName->vList.name) == thisContextSymbol) {
    compileByte(pushActiveContext);
    return;
  }

  variable = findVariable(varName->vList.name);
  if (variable == nil) {
    errorf("Undefined variable %s referenced", varName->vList.name);
    longjmp(badMethod, 1);
  }

  if (variable->scope == temporaryScope || variable->scope == receiverScope) {
    if (variable->varIndex <= 15) {
      if (variable->scope == temporaryScope) {
    compileByte(pushTemporaryVariable | variable->varIndex);
      } else {
    compileByte(pushReceiverVariable | variable->varIndex);
      }
    } else {
      compileByte(pushIndexed);
      location = (variable->scope == temporaryScope)
    ? temporaryLocation : receiverLocation;
      compileByte(location | variable->varIndex);
    }
  } else {
    if (variable->varIndex <= 31) {
      compileByte(pushLitVariable | variable->varIndex);
    } else {
      /* ??? check for variable index too large here? */
      compileByte(pushIndexed);
      compileByte(litVarLocation | variable->varIndex);
    }
  }
  freeSymbolEntry(variable);
}

/*
 *    static void compileConstant(constExpr)
 *
 * Description
 *
 *    Compile an expression that pushes a constant expression onto the stack.
 *    Special cases out the constants that the byte code interpreter knows
 *    about, which are the integers in the range -1 to 2.  Tries to emit the
 *    shortest possible byte sequence.
 *
 * Inputs
 *
 *    constExpr:
 *        A syntax tree node that represents a literal constant.
 *
 */
static void compileConstant(constExpr)
TreeNode constExpr;
{
  int        index;

  index = addConstant(constExpr);
  if (index < 0) {
    compileByte(pushSpecial | (index + 3 + 5));
  } else if (index <= 31) {
    compileByte(pushLitConstant | index);
  } else {
    compileByte(pushIndexed);
    compileByte(litConstLocation | index);
  }
}

/*
 *    static void compileBlock(blockExpr)
 *
 * Description
 *
 *    Compile the expressions for a block.  Also, emits code to create the
 *    block, and then to skip around it.  The block will have its initial
 *    byte pointer pointing to two bytes past the long jump instruction, so
 *    that when the block is invoked it will start off at the first byte of
 *    the block.
 *
 *
 * Inputs
 *
 *    blockExpr:
 *        A syntax tree node for a block expression.
 *
 */
static void compileBlock(blockExpr)
TreeNode blockExpr;
{
  ByteCodes    currentByteCodes, blockByteCodes;

  currentByteCodes = saveByteCodeArray(); /* ??? don't like this name */

  declareBlockArguments(blockExpr->vMethod.temporaries);
  compileBlockArguments(blockExpr->vMethod.temporaries);
  compileStatements(blockExpr->vMethod.statements, true);
  undeclareBlockArguments(blockExpr->vMethod.temporaries);

  blockByteCodes = getByteCodes();
  restoreByteCodeArray(currentByteCodes);

  /* emit standard byte sequence to invoke a block:
   *   push current context
   *   push number of block args
   *   blockCopy: send
   *   long jump around block bytecodes
   *   <block byte codes>...
   */
  compileByte(pushActiveContext);
  compilePushIntConstant(listLength(blockExpr->vMethod.temporaries));
  compileByte(blockCopyColonSpecial);
  compileByte(jumpLong | (byteCodeLength(blockByteCodes)/256)+4);
  compileByte(byteCodeLength(blockByteCodes) & 255);
  compileAndFreeByteCodes(blockByteCodes);

}

/*
 *    static void compileBlockArguments(args)
 *
 * Description
 *
 *    On entry to a block, its arguments (if any) are on the stack.  Since
 *    there is no way to refer to them via byte codes on the stack, the
 *    correct procedure is to pop them into temporary locations in the method
 *    itself.  Since we're popping from a stack, we need to pop the arguments
 *    in reverse order from the order that they are declared.  Args is a list
 *    of TreeNodes in declaration order, so we recurse to get the last one,
 *    pop it, get the penultimate, pop it, etc.  This routine works even if
 *    args is nil, in which case the block had no arguments.
 *
 * Inputs
 *
 *    args  : a TreeNode of type ListNode that is a list of argument names to
 *        the block being compiled.
 *
 */
static void compileBlockArguments(args)
TreeNode args;
{
  SymbolEntry    variable;

  if (args == nil) {
    return;
  }

  compileBlockArguments(args->vList.next);
  variable = findVariable(args->vList.name);
  if (variable->varIndex <= 7) {
    compileByte(popTemporaryVariable | variable->varIndex);
  } else {
    compileByte(popStoreIndexed);
    compileByte(temporaryLocation | variable->varIndex);
  }
  freeSymbolEntry(variable);
}

/*
 *    static void compileStatements(statementList, isBlock)
 *
 * Description
 *
 *    Compiles all of the statements in statement list.  Makes the final
 *    instruction of the block be a return top of stack, if the final
 *    statement isn't a return (^).
 *
 * Inputs
 *
 *    statementList:
 *        A TreeNode of type ExprNode that is the list of statements in
 *        the block.  If it is nil, the block's return value is nil.
 *    isBlock:A boolean.  If true, these statements are from a block
 *        context.  If false, they are just an ordinary statement list.
 */
static void compileStatements(statementList, isBlock)
TreeNode statementList;
Boolean    isBlock;
{
  TreeNode    stmt;

  if (statementList == nil) {
    if (isBlock) {
      compileByte(pushSpecial | nilIndex);
      compileByte(returnBlockStackTop);
    } else {
      compileByte(pushSpecial | nilIndex);
    }
    return;
  }

  for(stmt = statementList ; stmt; stmt = stmt->vExpr.expression) {
    compileStatement(stmt->vExpr.receiver);
    if (stmt->vExpr.expression == nil) {
      if (stmt->vExpr.receiver->nodeType != returnExprType) {
    /* if last statement isn't a return, then return the value on the
       stack as the result.  For non-block contexts, returning the top
       of the stack is the default, so it's ok.*/
    if (isBlock) {
      compileByte(returnBlockStackTop);
    }
      }
    } else {
      /* throw away the value on the top of the stack...we don't need it
     for all but the last one. */
      compileByte(popStackTop);
    }
  }
}


/*
 *    static void compileUnaryExpr(expr)
 *
 * Description
 *
 *    Compile code to evaluate a unary expression.  Special cases sends to
 *    "super" and duplicates the receiver's value if this is part of a
 *    cascaded message send.
 *
 * Inputs
 *
 *    expr  : A syntax tree node for a unary expression.
 *
 */
static void compileUnaryExpr(expr)
TreeNode expr;
{
  OOP        selector;
  int        selectorIndex;
  Boolean    savedDupFlag;

  savedDupFlag = dupMessageReceiver;
  dupMessageReceiver = false;

  selector = expr->vExpr.selector;
  selectorIndex = addSelector(selector);

  if (expr->vExpr.receiver != nil) {
    compileExpression(expr->vExpr.receiver);
    if (savedDupFlag) {
      compileByte(dupStackTop);
    }
    if (isSuper(expr->vExpr.receiver)) {
      if (selectorIndex < 0) {
    selectorIndex = addForcedSelector(selector);
      }
      hasExtendedSuper = true;
      if (selectorIndex <= 31) {
    compileByte(sendSuper1ExtByte);
    compileByte(selectorIndex);
      } else {
    compileByte(sendSuper2ExtByte);
    compileByte(0);
    compileByte(selectorIndex);
      }
      return;
    }
  }

  if (isNil(selector)) {
    errorf("Nil selector in unary expression");
    longjmp(badMethod, 1);
  }

  if (selectorIndex < 0) {
    compileByte(-selectorIndex);
  } else {
    compileSend(selectorIndex, 0);
  }
}

/*
 *    static void compileBinaryExpr(expr)
 *
 * Description
 *
 *    Compiles code for a binary message.  Special cases sends to super, as
 *    they get different byte codes.  Also, checks to see if it's the first
 *    part of a cascaded message send and if so emits code to duplicate the
 *    stack top after the evaluation of the receiver for use by the
 *    subsequent cascaded expressions.
 *
 * Inputs
 *
 *    expr  : A syntax tree node for a binary expression.
 *
 */
static void compileBinaryExpr(expr)
TreeNode expr;
{
  OOP        selector;
  int        selectorIndex;
  Boolean    savedDupFlag;

  savedDupFlag = dupMessageReceiver;
  dupMessageReceiver = false;

  selector = expr->vExpr.selector;
  selectorIndex = addSelector(selector);

  if (expr->vExpr.receiver) {
    compileExpression(expr->vExpr.receiver);
    if (savedDupFlag) {
      compileByte(dupStackTop);
    }
  }
  if (expr->vExpr.expression) {
    compileExpression(expr->vExpr.expression);
  }

  if (expr->vExpr.receiver) {
    if (isSuper(expr->vExpr.receiver)) {
      if (selectorIndex < 0) {
    selectorIndex = addForcedSelector(selector);
      }
      hasExtendedSuper = true;
      if (selectorIndex <= 31) {
    compileByte(sendSuper1ExtByte);
    compileByte((1 << 5) | selectorIndex);
      } else {
    compileByte(sendSuper2ExtByte);
    compileByte(1);
    compileByte(selectorIndex);
      }
      return;
    }
  }

  if (isNil(selector)) {
    errorf("nil selector in binary expression");
    longjmp(badMethod, 1);
  }

  if (selectorIndex < 0) {
    compileByte(-selectorIndex);
  } else {
    compileSend(selectorIndex, 1);
  }
}

/*
 *    static void compileKeywordExpr(expr)
 *
 * Description
 *
 *    Compile an keyword message send.  Special cases out while loops, the 4
 *    kinds of if tests, and the conditional "and" and conditional "or"
 *    messages.  If the expression isn't one of these, the expression is
 *    evaluated normally.  Has special hacks to support the duplication of
 *    the receiver's value in the case of the first part of a cascaded
 *    message send.
 *
 * Inputs
 *
 *    expr  : A syntax tree node that represents a keyword message send
 *        expression.
 *
 */
static void compileKeywordExpr(expr)
TreeNode expr;
{
  OOP        selector;
  int        selectorIndex, numArgs;
  Boolean    savedDupFlag;

  savedDupFlag = dupMessageReceiver;
  dupMessageReceiver = false;

  selector = computeSelector(expr);

  /* check for optimized cases of messages to booleans and handle them
     specially */
  if (selector == whileTrueColonSymbol || selector == whileFalseColonSymbol) {
    if (compileWhileLoop(selector, expr)) {
      return;
    }
  }

  if (expr->vExpr.receiver) {
    compileExpression(expr->vExpr.receiver);
    if (savedDupFlag) {
      compileByte(dupStackTop);
    }
  }

  if (selector == ifTrueColonSymbol || selector == ifFalseColonSymbol) {
    if (compileIfStatement(selector, expr->vExpr.expression)) {
      return;
    }
  } else if (selector == ifTrueColonIfFalseColonSymbol
         || selector == ifFalseColonIfTrueColonSymbol) {
    if (compileIfTrueFalseStatement(selector, expr->vExpr.expression)) {
      return;
    }
  } else if (selector == andColonSymbol || selector == orColonSymbol) {
    if (compileAndOrStatement(selector, expr->vExpr.expression)) {
      return;
    }
  }

  selectorIndex = addSelector(selector);
  numArgs = listLength(expr->vExpr.expression);

  compileKeywordList(expr->vExpr.expression);

  if (expr->vExpr.receiver) {
    if (isSuper(expr->vExpr.receiver)) {
      if (selectorIndex < 0) {
    selectorIndex = addForcedSelector(selector);
      }
      hasExtendedSuper = true;
      if (selectorIndex <= 31 && numArgs <= 7) {
    compileByte(sendSuper1ExtByte);
    compileByte((numArgs << 5) | selectorIndex);
      } else {
    compileByte(sendSuper2ExtByte);
    compileByte(numArgs);
    compileByte(selectorIndex);
      }
      return;
    }
  }

  if (selectorIndex < 0) {
    compileByte(-selectorIndex);
  } else {
    compileSend(selectorIndex, numArgs);
  }
}

/*
 *    static void compileKeywordList(list)
 *
 * Description
 *
 *    Emit code to evaluate each argument to a keyword message send.
 *
 * Inputs
 *
 *    list  : A list of expressions that represents the arguments to be
 *        evaluated.  A syntax tree node.
 *
 */
static void compileKeywordList(list)
TreeNode list;
{
  for (; list; list = list->vList.next) {
    compileExpression(list->vList.value);
  }
}

/*
 *    static Boolean compileWhileLoop(selector, expr)
 *
 * Description
 *
 *    Special case compilation of a #whileTrue: or #whileFalse: loop.
 *
 * Inputs
 *
 *    selector:
 *        Symbol, one of #whileTrue: or #whileFalse:.
 *    expr  : An expression that represents the entire while loop.
 *
 * Outputs
 *
 *    True if byte codes were emitted, false if not.  If either the receiver
 *    and the argument to the while message are not block expressions, this
 *    routine cannot do it's job, and so returns false to indicate as much.
 */
static Boolean compileWhileLoop(selector, expr)
OOP    selector;
TreeNode expr;
{
#ifndef old_code
  int        whileLoopLen, startLoopLen;
  ByteCodes    receiverExprCodes, whileExprCodes;

  if (expr->vExpr.receiver->nodeType != blockNodeType
      || expr->vExpr.expression->vList.value->nodeType != blockNodeType) {
    return (false);
  }

  startLoopLen = currentByteCodeLength();

  receiverExprCodes = compileSubExpression(expr->vExpr.receiver);
  whileExprCodes = compileSubExpression(expr->vExpr.expression->vList.value);
  compileAndFreeByteCodes(receiverExprCodes);

  /* skip to the while loop if the receiver block yields the proper value */
  compileJump(2, (selector == whileTrueColonSymbol) ? trueJump : falseJump);

  /* otherwise, skip to the end, past the pop stack top and 2 byte goto
   * and exit the loop */
  compileLongJump(byteCodeLength(whileExprCodes)+3);

  compileAndFreeByteCodes(whileExprCodes);
  compileByte(popStackTop);    /* we don't care about while expr's value */

  /* +2 since we're using a 2 byte jump instruction here, so we have to
     skip back over it in addition to the other instructions */
  whileLoopLen = currentByteCodeLength() - startLoopLen +2;

  compileLongJump(-whileLoopLen);

  /* while loops always return nil (ain't expression languages grand?) */
  compileByte(pushSpecial | nilIndex);
  return (true);
#else
  int        whileLoopLen, startLoopLen;
  ByteCodes    receiverExprCodes, whileExprCodes;

  if (expr->vExpr.receiver->nodeType != blockNodeType
      || expr->vExpr.expression->vList.value->nodeType != blockNodeType) {
    return (false);
  }

  startLoopLen = currentByteCodeLength();

  receiverExprCodes = compileSubExpression(expr->vExpr.receiver);
  whileExprCodes = compileSubExpression(expr->vExpr.expression->vList.value);
  compileAndFreeByteCodes(receiverExprCodes);

  /* skip around the while expr and the pop stack top and the 2 byte goto
     that follows if the condition doesn't match the while test. */
  compileJump(byteCodeLength(whileExprCodes)+3,
          (selector == whileTrueColonSymbol) ? falseJump : trueJump);

  compileAndFreeByteCodes(whileExprCodes);
  compileByte(popStackTop);    /* we don't care about while expr's value */

  /* +2 since we're using a 2 byte jump instruction here, so we have to
     skip back over it in addition to the other instructions */
  whileLoopLen = currentByteCodeLength() - startLoopLen +2;
  /* this is a backwards branch, but you can't tell it */
  compileByte(jumpLong | (4 - ((whileLoopLen+255)/256)));
  compileByte((-whileLoopLen) & 255);

  compileByte(pushSpecial | nilIndex);
  return (true);
#endif
}

/*
 *    static Boolean compileIfTrueFalseStatement(selector, expr)
 *
 * Description
 *
 *    Special case compile of the code for #ifTrue:false: and #ifFalse:true:
 *    messages.
 *
 * Inputs
 *
 *    selector:
 *        Symbol, one of #ifTrue:false: or #ifFalse:true:
 *    expr  : An tree node that represents the expressions for the first and
 *        second arguments to the message.  If either is not a block type
 *        expression, no byte codes are emitted, and this routine
 *        returns false.
 *
 * Outputs
 *
 *    True if the byte codes to perform the test were successfully emitted,
 *    false if not.
 */
static Boolean compileIfTrueFalseStatement(selector, expr)
OOP    selector;
TreeNode expr;
{
  ByteCodes    trueByteCodes, falseByteCodes;

  if (expr->vList.value->nodeType != blockNodeType
      || expr->vList.next->vList.value->nodeType != blockNodeType) {
    return (false);
  }

  if (selector == ifTrueColonIfFalseColonSymbol) {
    falseByteCodes = compileSubExpression(expr->vList.next->vList.value);
    trueByteCodes =
      compileSubExpressionWithGoto(expr->vList.value,
                   byteCodeLength(falseByteCodes));
  } else {
    falseByteCodes = compileSubExpression(expr->vList.value);
    trueByteCodes =
      compileSubExpressionWithGoto(expr->vList.next->vList.value,
                   byteCodeLength(falseByteCodes));
  }

  compileJump(byteCodeLength(trueByteCodes), falseJump);
  compileAndFreeByteCodes(trueByteCodes);
  compileAndFreeByteCodes(falseByteCodes);
  return (true);
}

/*
 *    static Boolean compileIfStatement(selector, expr)
 *
 * Description
 *
 *    Special case compile of code for an #ifTrue: or #ifFalse: message.  The
 *    default value of an "if" type message is nil.
 *
 * Inputs
 *
 *    selector:
 *        Symbol, one of #ifTrue: or #ifFalse:
 *    expr  : An expression to be evaluated if the given condition holds.
 *
 * Outputs
 *
 *    True if byte codes were emitted, false if not (as is the case if the
 *    expression following the selector is not a block).
 */
static Boolean compileIfStatement(selector, expr)
OOP    selector;
TreeNode expr;
{
  ByteCodes    thenByteCodes, defaultByteCodes;

  if (expr->vList.value->nodeType != blockNodeType) {
    return (false);
  }

  thenByteCodes = compileSubExpression(expr->vList.value);
  defaultByteCodes = compileDefaultValue(nilIndex,
                     byteCodeLength(thenByteCodes));
  compileJump(byteCodeLength(defaultByteCodes),
          (selector == ifTrueColonSymbol) ? trueJump : falseJump);
  compileAndFreeByteCodes(defaultByteCodes);
  compileAndFreeByteCodes(thenByteCodes);
  return (true);
}



/*
 *    static Boolean compileAndOrStatement(selector, expr)
 *
 * Description
 *
 *    Special casing for and: an or: messages.  Emits code that jumps on the
 *    condition (true for and:, false for or:) to the actual expression for
 *    the block that's the argument to the message.  Then emits code that
 *    pushes the default value onto the stack, which will be only executed in
 *    the failure cases.  Then emits the code for the evaluation of the block
 *    that's the argument to the message.
 *
 * Inputs
 *
 *    selector:
 *        A Symbol, either #and: or #or:.
 *    expr  : A syntax tree piece that represents the expressions contained
 *        in the block that's passed as an argument of the message.
 *
 * Outputs
 *
 *    Returns true if the code was successfully emitted, and false if the
 *    code was not (such as a non-block following the selector).
 */
static Boolean compileAndOrStatement(selector, expr)
OOP    selector;
TreeNode expr;
{
  ByteCodes    blockByteCodes, defaultByteCodes;
  int        blockLen;

  /* I elected for simplicty sake to just emit the same kind of code always,
     and not try to save a byte by using the jump false. */

  if (expr->vList.value->nodeType != blockNodeType) {
    return (false);
  }

  blockByteCodes = compileSubExpression(expr->vList.value);
  blockLen = byteCodeLength(blockByteCodes);
  defaultByteCodes = compileDefaultValue((selector == andColonSymbol)
                     ? falseIndex : trueIndex, blockLen);
  compileJump(byteCodeLength(defaultByteCodes),
          (selector == andColonSymbol) ? trueJump : falseJump);
  compileAndFreeByteCodes(defaultByteCodes);
  compileAndFreeByteCodes(blockByteCodes);
  return (true);
}

/*
 *    static ByteCodes compileDefaultValue(litIndex, realExprLen)
 *
 * Description
 *
 *    Compiles and returns a byte code sequence that represents the default
 *    value of a conditional expression, such as IfTrue: when the receiver is
 *    false.  The sequence causes the default value to be pushed on the
 *    stack, and then the byte codes for the non-default value to be jumped
 *    around.
 *
 * Inputs
 *
 *    litIndex:
 *        The index for the value to push, typcially one of true, false,
 *        or nil.  Used as part of a pushSpecial byte code.
 *    realExprLen:
 *        A C int that represents the length of the byte codes that are
 *        evaluated in the non-default case.
 *
 * Outputs
 *
 *    A sequence of byte codes pushes the default value and skips around the
 *    computation of the real value.
 */
static ByteCodes compileDefaultValue(litIndex, realExprLen)
int    litIndex, realExprLen;
{
  ByteCodes    currentByteCodes, defaultByteCodes;

  currentByteCodes = saveByteCodeArray(); /* ??? don't like this name */

  compileByte(pushSpecial | litIndex);
  compileJump(realExprLen, unconditionalJump);

  defaultByteCodes = getByteCodes();
  restoreByteCodeArray(currentByteCodes);

  return (defaultByteCodes);
}

/*
 *    static ByteCodes compileSubExpression(expr)
 *
 * Description
 *
 *    Compile a "block" in a separate context and return the resulting
 *    bytecodes.  The block will not have argument declarations as it's only
 *    the code for things like ifTrue:, and:, whileTrue:, etc.  It is
 *    compiled as a list of statements such that the last statement leaves
 *    the value that is produced on the stack, as the value of the "block".
 *
 * Inputs
 *
 *    expr  : A "block" TreeNode that has no arguments.
 *
 * Outputs
 *
 *    A ByteCodes vector of byte codes that represent the execution of the
 *    statements in the "block".
 */
static ByteCodes compileSubExpression(expr)
TreeNode expr;
{
  return (compileSubExpressionWithGoto(expr, 0));
}


/*
 *    static ByteCodes compileSubExpressionWithGoto(expr, branchLen)
 *
 * Description
 *
 *    Like compileSubExpression, except that this sub expression always ends
 *    with an unconditional branch past "branchLen" bytecodes.
 *
 * Inputs
 *
 *    expr  : a TreeNode that looks like a "block".
 *    branchLen:
 *        number of bytes to skip over, possibly zero (in which case no
 *        goto is generated).
 *
 * Outputs
 *
 *    ByteCodes that represent the execution of the statements in "expr",
 *    with a goto after them (if "branchLen" is nonzero).
 */
static ByteCodes compileSubExpressionWithGoto(expr, branchLen)
TreeNode expr;
int    branchLen;
{
  ByteCodes    currentByteCodes, subExprByteCodes;

  currentByteCodes = saveByteCodeArray(); /* ??? don't like this name */

  compileStatements(expr->vMethod.statements, false);
  if (branchLen) {
    compileJump(branchLen, unconditionalJump);
  }

  subExprByteCodes = getByteCodes();
  restoreByteCodeArray(currentByteCodes);

  return (subExprByteCodes);
}

/*
 *    static void compileJump(len, jumpType)
 *
 * Description
 *
 *    Compiles a jump instruction, using the smallest possible number of byte
 *    codes.  Special cases for the unconditional jump and the short false
 *    jump that the byte code interpreter handles.
 *
 * Inputs
 *
 *    len   : Number of byte codes to jump forward (only forward jumps are
 *        handled.  A C int > 0.
 *    jumpType:
 *        An enumerated value that indicates whether the jump is
 *        unconditional, or a true or false jump.
 *
 */
static void compileJump(len, jumpType)
int    len;
JumpType jumpType;
{
  if (len <= 0) {
    errorf("Illegal length jump %d\n", len);
    longjmp(badMethod, 1);
  }

  switch (jumpType) {
  case unconditionalJump:
    if (len <= 8) {
      compileByte(jumpShort | (len - 1));
    } else {
      compileByte(jumpLong | (4 + len/256));
      compileByte(len & 255);
    }
    break;

  case falseJump:
    if (len <= 8) {
      compileByte(popJumpFalseShort | (len - 1));
    } else {
      compileByte(popJumpFalse | (len/256));
      compileByte(len & 255);
    }
    break;

  case trueJump:
    compileByte(popJumpTrue | (len/256));
    compileByte(len & 255);
    break;
  }
}

/*
 *    compileLongJump(len)
 *
 * Description
 *
 *    Compiles an unconditional long jump, forward or backward.
 *
 * Inputs
 *
 *    len   : Number of bytes to jump.  Can be negative.
 *
 */
compileLongJump(len)
long    len;
{
  compileByte(jumpLong | (((len >> 8) + 4) & 7) );
  compileByte(len & 255);
}

/*
 *    compilePushIntConstant(intConst)
 *
 * Description
 *
 *    Compiles an instruction to push an Integer constant on the stack.
 *    Special cases out the literals -1..2, and tries to emit the shortest
 *    possible byte sequence to get the job done.
 *
 * Inputs
 *
 *    intConst:
 *        The constant to be pushed; a C int.
 *
 */
compilePushIntConstant(intConst)
int    intConst;
{
  TreeNode    constExpr;
  int        constIndex;

  if (intConst >= -1 && intConst <= 2) {
    compileByte(pushSpecial | intConst + 5);
    return;
  }

  /* a hack to make use of the functionality provided by addConstant */
  constExpr = makeIntConstant((long)intConst);
  constIndex = addConstant(constExpr);
  freeTree(constExpr);

  if (constIndex <= 31) {
    compileByte(pushLitConstant | constIndex);
  } else {
    compileByte(pushIndexed | litConstLocation);
    compileByte(constIndex);
  }
}


/*
 *    static void compileSend(selectorIndex, numArgs)
 *
 * Description
 *
 *    Compile a message send byte code.  Tries to use the minimal length byte
 *    code sequence; does not know about the special messages that the
 *    interpreter has "wired in"; those should be handled specially and this
 *    routine should not be called with them (it's ok if it is, just not
 *    quite as efficient).
 *
 * Inputs
 *
 *    selectorIndex:
 *        The index in the literal vector of the selector for the send
 *    numArgs:
 *        The number of arguments that the selector takes. A C integer.
 *
 */
static void compileSend(selectorIndex, numArgs)
int    selectorIndex, numArgs;
{
  if (numArgs <= 2 && selectorIndex <= 15) {
    switch (numArgs) {
    case 0:
      compileByte(sendSelectorNoArg | selectorIndex);
      break;
    case 1:
      compileByte(sendSelector1Arg | selectorIndex);
      break;
    case 2:
      compileByte(sendSelector2Arg | selectorIndex);
      break;
    }
  } else if (selectorIndex <= 31 && numArgs <= 7) {
    compileByte(sendSelector1ExtByte);
    compileByte((numArgs << 5) | selectorIndex);
  } else {
    compileByte(sendSelector2ExtByte);
    compileByte(numArgs);
    compileByte(selectorIndex);
  }
}

/*
 *    static void compileCascadedMessage(cascadedExpr)
 *
 * Description
 *
 *    Compiles the code for a cascaded message send.  Due to the fact that
 *    cascaded sends go to the receiver of the last message before the first
 *    cascade "operator" (the ";"), the system to perform cascaded message
 *    sends is a bit kludgy.  We basically turn on a flag to the compiler
 *    that indicates that the value of the receiver of the last message
 *    before the cascaded sends is to be duplicated; and then compile code
 *    for each cascaded expression, throwing away the result, and duplicating
 *    the original receiver so that it can be used by the current message
 *    send, and following ones.
 *
 * Inputs
 *
 *    cascadedExpr:
 *        A tree node that represents a cascaded expression.  Both the
 *        initial receiver and all the subsequent cascaded sends can be
 *        derived from this node.
 *
 */
static void compileCascadedMessage(cascadedExpr)
TreeNode cascadedExpr;
{
  TreeNode message;

  dupMessageReceiver = true;
  compileExpression(cascadedExpr->vExpr.receiver);

  for(message = cascadedExpr->vExpr.expression; message;
      message = message->vList.next) {
    compileByte(popStackTop);
    if (message->vList.next) {
      compileByte(dupStackTop);
    }
    compileExpression(message->vList.value);
    /* !!! remember that unary, binary and keywordexpr should ignore the
       receiver field if it is nil; that is the case for these functions
       and things work out fine if that's the case. */
  }
}


/*
 *    static void compileAssignments(varList)
 *
 * Description
 *
 *    Compiles all the assignments in "varList", which is a TreeNode of type
 *    listNode.  The generated code assumes that the value on the top of the
 *    stack is what's to be used for the assignment.  Since this routine has
 *    no notion of now the value on top of the stack will be used by the
 *    calling environment, it makes sure that when the assignments are
 *    through, that the value on top of the stack after the assignment is the
 *    same as the value on top of the stack before the assignment.  The
 *    optimizer should fix this in the unnecessary cases.
 *
 * Inputs
 *
 *    varList:
 *            TreeNode of type listNode that contains the names of the
 *        variables to be assigned into.
 *
 */
static void compileAssignments(varList)
TreeNode varList;
{
  SymbolEntry    variable;
  int        locationIndex;

  for (; varList; varList = varList->vList.next) {
    variable = findVariable(varList->vList.name);
    if (variable == nil) {
      errorf("assignment to undeclared variable %s", varList->vList.name);
      longjmp(badMethod, 1);
    }
    /* Here we have several kinds of things to store: receiver variable,
       temporary variable, "literal" variable (reference by association). */

    if ((variable->scope == temporaryScope
    || variable->scope == receiverScope) && variable->varIndex <= 7) {
      compileByte(dupStackTop);
      compileByte(variable->scope == temporaryScope ?
          popTemporaryVariable | variable->varIndex :
          popReceiverVariable | variable->varIndex);
    } else {
      locationIndex = computeLocationIndex(variable);
      compileByte(storeIndexed);
      compileByte(locationIndex | variable->varIndex);
    }
    freeSymbolEntry(variable);
  }
}

/*
 *    static int computeLocationIndex(variable)
 *
 * Description
 *
 *    Given an internal representation of a variable, this routine returns
 *    an indicator of how to access the variable.  Depending on the source of
 *    the variable, this access location (which is actually to be compiled in
 *    as part of generated byte codes) can be an instance variable in the
 *    receiver, a temporary variable in the method context (includes
 *    arguments to the method) or a global or pool variable, which are
 *    referenced by a name/value Association.
 *
 * Inputs
 *
 *    variable:
 *        Internal compiler variable.
 *
 * Outputs
 *
 *    Indication of how to access the variable.  A portion of a byte code
 *    that represents the various types of storage locations.
 */
static int computeLocationIndex(variable)
SymbolEntry variable;
{
  switch (variable->scope) {
  case receiverScope:
    return (receiverLocation);
  case temporaryScope:
    return (temporaryLocation);
  case globalScope: case poolScope:
    return (litVarLocation);
  }

  errorf("Unhandled case in computeLocationIndex\n");
  return (0);
}

/*
 *    static int isSpecialVariable(expr)
 *
 * Description
 *
 *    Examines the expression "expr" to see if it is a variable in the set
 *    "self", "false", "true", "nil".  Returns the "index" (number in 0..3)
 *    if true, -1 if false.  For this use, "super" is defined to be the
 *    equivalent of self.
 *
 * Inputs
 *
 *    expr  : TreeNode expression to be examined
 *
 * Outputs
 *
 *    -1 if expr is not a special variable
 *    0..3 if expr is "self", "true", "false", "nil", respectively.
 *    "super" is the same as self.
 */
static int isSpecialVariable(expr)
TreeNode expr;
{
  OOP        variable;

  if (expr->nodeType != variableNodeType) {
    return (-1);
  }

  variable = internString(expr->vList.name);
  if (variable == selfSymbol || variable == superSymbol) {
    return (receiverIndex);
  } else if (variable == trueSymbol) {
    return (trueIndex);
  } else if (variable == falseSymbol) {
    return (falseIndex);
  } else if (variable == nilSymbol) {
    return (nilIndex);
  } else {
    return (-1);
  }
}


/*
 *    static Boolean isSuper(expr)
 *
 * Description
 *
 *    Returns true if the expression passed to it represents the symbol
 *    "super"; false if not.
 *
 * Inputs
 *
 *    expr  : TreeNode that is an expression of some kind
 *
 * Outputs
 *
 *    true if "super" variable, false otherwise.
 */
static Boolean isSuper(expr)
TreeNode expr;
{
  if (expr->nodeType != variableNodeType) {
    return (false);
  }

  return (internString(expr->vList.name) == superSymbol);
}


/*
 *    static int addConstant(constExpr)
 *
 * Description
 *
 *    Scans the constants that are referenced by the current method.  If one
 *    is found that is equal to constExpr, the index of that constant is
 *    returned.  Otherwise, the constant is turned into a constant object,
 *    added to the constants of the method, and the new index is returned.
 *
 * Inputs
 *
 *    constExpr:
 *        TreeNode of type constExprType, containing a literal constant
 *        of some kind.  Special cases -1, 0, 1, and 2 since they are
 *        available directly via instructions.
 *
 * Outputs
 *
 *    Index in the method's table of where this constant can be found,
 *    whether or not it was already there.  Returns a negative number if
 *    the constant is one of the above mentioned integers; in fact, the value
 *    returned is such that 3+returnValue is the numerical value.
 */
static int addConstant(constExpr)
TreeNode constExpr;
{
  int        i;
  long        intVal;
  OOP        constantOOP;

  for (i = 0; i < numLiterals; i++) {
    if (equalConstant(literalVec[i], constExpr)) {
      return (i);
    }
  }

  constantOOP = makeConstantOOP(constExpr);
  if (isInt(constantOOP)) {
    intVal = toInt(constantOOP);
    if (intVal >= -1 && intVal <= 2) {
      return ((int)(intVal - 3));
    }
  }

  return (addLiteral(constantOOP));
}

/*
 *    static Boolean equalConstant(oop, constExpr)
 *
 * Description
 *
 *    Returns true if "oop" and "constExpr" represent the same literal value.
 *    Primarily used by the compiler to store a single copy of duplicated
 *    literals in a method.  Can call itself in the case array literals.
 *
 * Inputs
 *
 *    oop   : An OOP that represents a constant value
 *    constExpr:
 *        A piece of the syntax tree that represents a literal value.
 *
 * Outputs
 *
 *    True if "oop" and "constExpr" represent the same value; false
 *    otherwise.
 */
static Boolean equalConstant(oop, constExpr)
OOP    oop;
TreeNode constExpr;
{
  TreeNode    arrayElt;
  int        len, i;

  /* ??? this kind of special casing of the elements of arrays bothers
     me...it should all be in one neat place. */
  if (constExpr->nodeType == symbolNodeType) { /* symbol in array constant */
    return (oop == constExpr->vExpr.selector);
  } else if (constExpr->nodeType == arrayEltListType) {
    if (isOOP(oop) && oopToObj(oop)->objClass == arrayClass) {
      for(len = 0, arrayElt = constExpr; arrayElt;
      len++, arrayElt = arrayElt->vList.next);

      if (len == numOOPs(oopToObj(oop))) {
    for (i = 1, arrayElt = constExpr; i <= len;
         i++, arrayElt = arrayElt->vList.next) {
      if (!equalConstant(arrayAt(oop, i), arrayElt->vList.value)) {
        return (false);
      }
    }
    return (true);
      }
    }
    return (false);
  }



  switch (constExpr->vConst.constType) {
  case intConst:
    if (oop == fromInt(constExpr->vConst.val.iVal)) {
      return (true);
    }
    break;

  case floatConst:
    if (isOOP(oop) && oopToObj(oop)->objClass == floatClass) {
      if (constExpr->vConst.val.fVal == floatOOPValue(oop)) {
    return (true);
      }
    }
    break;

  case charConst:
    if (oop == charOOPAt(constExpr->vConst.val.cVal)) {
      return (true);
    }
    break;

  case stringConst:
    if (isOOP(oop) && oopToObj(oop)->objClass == stringClass) {
      len = strlen(constExpr->vConst.val.sVal);
      if (len == stringOOPLen(oop)) {
    if (strncmp((char *)oopToObj(oop)->data, constExpr->vConst.val.sVal,
            len) == 0) {
      return (true);
    }
      }
    }
    break;

  case symbolConst:
    if (oop == constExpr->vConst.val.symVal) {
      return (true);
    }
    break;

  case arrayConst:
    if (isOOP(oop) && oopToObj(oop)->objClass == arrayClass) {
      /* ??? could keep the length in a counter */
      for(len = 0, arrayElt = constExpr->vConst.val.aVal; arrayElt;
      len++, arrayElt = arrayElt->vList.next);
      if (len == numOOPs(oopToObj(oop))) {
    for (i = 1, arrayElt = constExpr->vConst.val.aVal; i <= len;
         i++, arrayElt = arrayElt->vList.next) {
      if (!equalConstant(arrayAt(oop, i), arrayElt->vList.value)) {
        return (false);
      }
#ifdef bogus /* Sat Feb 16 14:30:37 1991 */
/**/      if (!equalConstant(arrayElt->vList.value, arrayAt(oop, i))) {
/**/        return (false);
/**/      }
#endif /* bogus Sat Feb 16 14:30:37 1991 */
    }
    return (true);
      }
    }
    break;
  }

  return (false);
}

/*
 *    static OOP makeConstantOOP(constExpr)
 *
 * Description
 *
 *    Given a section of the syntax tree that represents a Smalltalk
 *    constant, this routine creates an OOP to be stored as a method literal
 *    in the method that's currently being compiled.
 *
 * Inputs
 *
 *    constExpr:
 *        A portion of the tree that contains a constant value, including
 *        array constants.
 *
 * Outputs
 *
 *    An OOP that represents the constant's value.
 */
static OOP makeConstantOOP(constExpr)
TreeNode constExpr;
{
  TreeNode    arrayElt;
  int        len, i;
  OOP        resultOOP;

  if (constExpr->nodeType == symbolNodeType) { /* symbol in array constant */
    return (constExpr->vExpr.selector);
  } else if (constExpr->nodeType == arrayEltListType) {
    for(len = 0, arrayElt = constExpr; arrayElt;
    len++, arrayElt = arrayElt->vList.next);

    /* ??? this might be an uninitialized form of array creation for speed */
    resultOOP = arrayNew(len);

    for (i = 1, arrayElt = constExpr; i <= len;
     i++, arrayElt = arrayElt->vList.next) {
      arrayAtPut(resultOOP, i, makeConstantOOP(arrayElt->vList.value));
    }
    return (resultOOP);
  }

  switch (constExpr->vConst.constType) {
  case intConst:
    return (fromInt(constExpr->vConst.val.iVal));

  case floatConst:
    return (floatNew(constExpr->vConst.val.fVal));

  case charConst:
    return (charOOPAt(constExpr->vConst.val.cVal));

  case stringConst:
    return (stringNew(constExpr->vConst.val.sVal));

  case symbolConst:
    return (constExpr->vConst.val.symVal);

  case arrayConst:
    for(len = 0, arrayElt = constExpr->vConst.val.aVal; arrayElt;
    len++, arrayElt = arrayElt->vList.next);

    /* ??? this might be an uninitialized form of array creation for speed */
    resultOOP = arrayNew(len);

    for (i = 1, arrayElt = constExpr->vConst.val.aVal; i <= len;
     i++, arrayElt = arrayElt->vList.next) {
      arrayAtPut(resultOOP, i, makeConstantOOP(arrayElt->vList.value));
    }
    return (resultOOP);
  }

  return (nilOOP);
}

/*
 *    static int addSelector(selector)
 *
 * Description
 *
 *    Like addConstant, this routine adds "selector" to the set of selectors
 *    for the current method, and returns the index of that selector.  If the
 *    selector already existed, its index is returned.  If the selector is
 *    a special selector, then the negative of the bytecode that's associated
 *    with that special selector is returned.
 *
 * Inputs
 *
 *    selector:
 *        A symbol that is the selector to be added to the selectors of
 *        the current method.
 *
 * Outputs
 *
 *    Index of the selector in the current method, or number < 0 which is
 *    the negative of the bytecode for a send special.
 */
static int addSelector(selector)
OOP    selector;
{
  int        builtin;

  if ((builtin = whichBuiltinSelector(selector)) != 0) {
    return (-builtin);
  } else {
    return (addForcedSelector(selector));
  }
}

/*
 *    static int whichBuiltinSelector(selector)
 *
 * Description
 *
 *    Looks for special-cased selectors, and returns a special number to
 *    indicate which selector was chosen.  If the selector isn't one of the
 *    special-cased ones, 0 is returned.
 *
 * Inputs
 *
 *    selector:
 *        An instance of Symbol, to be special-cased.
 *
 * Outputs
 *
 *    0 if the selector isn't special-cased, otherwise an index to be used
 *    by the compiler for the selector.
 */
static int whichBuiltinSelector(selector)
OOP    selector;
{
  if (selector == atColonSymbol) {
    return (atColonSpecial);
  } else if (selector == atColonPutColonSymbol) {
    return (atColonPutColonSpecial);
  } else if (selector == sizeSymbol) {
    return (sizeSpecial);
  } else if (selector == nextSymbol) {
    return (nextSpecial);
  } else if (selector == nextPutColonSymbol) {
    return (nextPutColonSpecial);
  } else if (selector == atEndSymbol) {
    return (atEndSpecial);
  } else if (selector == classSymbol) {
    return (classSpecial);
  } else if (selector == blockCopyColonSymbol) {
    return (blockCopyColonSpecial);
  } else if (selector == valueSymbol) {
    return (valueSpecial);
  } else if (selector == valueColonSymbol) {
    return (valueColonSpecial);
  } else if (selector == doColonSymbol) {
    return (doColonSpecial);
  } else if (selector == newSymbol) {
    return (newSpecial);
  } else if (selector == newColonSymbol) {
    return (newColonSpecial);
  } else if (selector == plusSymbol) {
    return (plusSpecial);
  } else if (selector == minusSymbol) {
    return (minusSpecial);
  } else if (selector == lessThanSymbol) {
    return (lessThanSpecial);
  } else if (selector == greaterThanSymbol) {
    return (greaterThanSpecial);
  } else if (selector == lessEqualSymbol) {
    return (lessEqualSpecial);
  } else if (selector == greaterEqualSymbol) {
    return (greaterEqualSpecial);
  } else if (selector == equalSymbol) {
    return (equalSpecial);
  } else if (selector == notEqualSymbol) {
    return (notEqualSpecial);
  } else if (selector == timesSymbol) {
    return (timesSpecial);
  } else if (selector == divideSymbol) {
    return (divideSpecial);
  } else if (selector == remainderSymbol) {
    return (remainderSpecial);
  } else if (selector == bitShiftColonSymbol) {
    return (bitShiftColonSpecial);
  } else if (selector == integerDivideSymbol) {
    return (integerDivideSpecial);
  } else if (selector == bitAndColonSymbol) {
    return (bitAndColonSpecial);
  } else if (selector == bitOrColonSymbol) {
    return (bitOrColonSpecial);
  } else if (selector == sameObjectSymbol) {
    return (sameObjectSpecial);
  } else {
    return (0);
  }
}


/*
 *    static int addForcedSelector(selector)
 *
 * Description
 *
 *    Adds the given selector to the method literals, returning the index
 *    that the selector was stored under.
 *
 * Inputs
 *
 *    selector:
 *        An instance of Symbol to be added.
 *
 * Outputs
 *
 *    Index of where in the literal vector the Symbol was stored.
 */
static int addForcedSelector(selector)
OOP    selector;
{

  return (addForcedObject(selector));
}

/*
 *    int addForcedObject(oop)
 *
 * Description
 *
 *    Adds "oop" to the literal vector that's being created, unless it's
 *    already there.  "Already there" is defined as the exact same object is
 *    present in the literal vector.
 *
 * Inputs
 *
 *    oop   : An OOP to be added to the literal vector.
 *
 * Outputs
 *
 *    Index into the literal vector where the object was stored.  Seems like
 *    it's zero based, but I believe in practice that it's 1 based.
 */
int addForcedObject(oop)
OOP    oop;
{
  int        i;

  for (i = 0; i < numLiterals; i++) {
    if (literalVec[i] == oop) {
      return (i);
    }
  }

  return (addLiteral(oop));
}

/*
 *    static OOP computeSelector(selectorExpr)
 *
 * Description
 *
 *    Given a TreeNode of type keywordExprNode, this routine picks out the
 *    names selector "keywords", concatenates them, turns them into a symbol
 *    and returns that symbol.  This routine may also be called with a
 *    unaryExprType or binaryExprType tree node, in which case the selector
 *    is already known, so it is just returned.
 *
 * Inputs
 *
 *    selectorExpr:
 *        TreeNode node of type keywordExprNode, unaryExprType, or
 *        binaryExprType.
 *
 * Outputs
 *
 *    Symbol OOP that is the selector that "selectorExpr" represents.
 */
static OOP computeSelector(selectorExpr)
TreeNode selectorExpr;
{
  TreeNode    keyword;
  int        len;
  char        *nameBuf, *p;

  if (selectorExpr->nodeType == unaryExprType
      || selectorExpr->nodeType == binaryExprType) {
    return (selectorExpr->vExpr.selector);
  }

  len = 0;
  for (keyword = selectorExpr->vExpr.expression; keyword != nil;
       keyword = keyword->vList.next) {
    len += strlen(keyword->vList.name);
  }

  p = nameBuf = (char *)alloca(len+1);
  for (keyword = selectorExpr->vExpr.expression; keyword != nil;
       keyword = keyword->vList.next) {
    len = strlen(keyword->vList.name);
    strcpy(p, keyword->vList.name);
    p += len;
  }

  *p = '\0';

  return (internString(nameBuf));
}


/*
 *    static void addMethodClassVariable()
 *
 * Description
 *
 *    Called when a method contains at least one reference to super as a
 *    receiver, this routine makes sure that the last literal variable of the
 *    method is the class that the method is a part of.
 *
 */
static void addMethodClassVariable()
{
  addLiteral(associationNew(getClassSymbol(thisClass), thisClass));
}


/*
 *    initCompiler()
 *
 * Description
 *
 *    Prepares the compiler for execution.
 *
 */
initCompiler()
{
  hasExtendedSuper = false;
  initArgCount();
  initTempCount();
  initLiteralVec();
  initByteCodes();
}

/*
 *    static int listLength(listExpr)
 *
 * Description
 *
 *    Computes and returns the length of a parse tree list.
 *
 * Inputs
 *
 *    listExpr:
 *        A list from the tree builder.
 *
 * Outputs
 *
 *    The length of the list, as an integer.
 */
static int listLength(listExpr)
TreeNode listExpr;
{
  TreeNode     l;
  long        len;

  for(len = 0, l = listExpr; l; l = l->vList.next, len++);

  if (sizeof(int) != 4) {
    if (len > (1L << (sizeof(int)*8 - 1))) {
      errorf("List too long, %ld", len);
      len = 1L << (sizeof(int)*8 - 1);
    }
  }

  return ((int)len);
}

/*
 *    static ByteCodes optimizeByteCodes(byteCodes)
 *
 * Description
 *
 *    Intended to scan the byte codes of a method, performing optimizations,
 *    and return a new vector of byte codes that represents the optimized
 *    byte code stream.  Currently a NOP.
 *
 * Inputs
 *
 *    byteCodes:
 *        A vector of byte codes to be optimized.
 *
 * Outputs
 *
 *    Currently, the same byte codes that were passed in.
 */
static ByteCodes optimizeByteCodes(byteCodes)
ByteCodes byteCodes;
{
  /* ??? no optimization for now */
  return (byteCodes);
}


/***********************************************************************
 *
 *    Literal Vector manipulation routines.
 *
 ***********************************************************************/


/*
 *    static void initLiteralVec()
 *
 * Description
 *
 *    Prepares the literal vector for use.  The literal vector is where the
 *    compiler will store any literals that are used by the method being
 *    compiled.  The literal vector will grow as needed to accomodate the
 *    literals of the method.
 *
 */
static void initLiteralVec()
{
  numLiterals = 0;

  literalVecMax = LITERAL_VEC_CHUNK_SIZE;
  literalVec = (OOP *)malloc(LITERAL_VEC_CHUNK_SIZE*sizeof(OOP));
}

/*
 *    static int addLiteral(OOP)
 *
 * Description
 *
 *    Adds "OOP" to the literals associated with the method being compiled
 *    and returns the index of the literal slot that was used (1 based).
 *
 * Inputs
 *
 *    oop:    OOP to add to the literal vector.
 *
 * Outputs
 *
 *    Index (1 based) in the literal vector of where the OOP was added.
 */
static int addLiteral(oop)
OOP    oop;
{
  if (numLiterals >= literalVecMax) {
    reallocLiteralVec();
  }

  literalVec[numLiterals] = oop;
  return (numLiterals++);
}

/*
 *    static void reallocLiteralVec()
 *
 * Description
 *
 *    Called to grow the literal vector that the compiler is using.  Modifies
 *    the global variables "literalVec" and "literalVecMax" to reflect the
 *    growth.
 *
 */
static void reallocLiteralVec()
{
  literalVecMax += LITERAL_VEC_CHUNK_SIZE;
  literalVec = (OOP *)realloc(literalVec, literalVecMax * sizeof(OOP));
}


/*
 *    OOP getMethodLiterals()
 *
 * Description
 *
 *    Creates a new array object that contains the literals for the method
 *    that's being compiled and returns it.  As a side effect, the currently
 *    allocated working literal vector is freed.  If there were no literals
 *    for the current method, nilOOP is returned.
 *
 * Outputs
 *
 *    The newly created array object, or nilOOP.
 */
static OOP getMethodLiterals()
{
  OOP        methodLiterals;
  int        i;

  if (numLiterals == 0) {
    return (nilOOP);
  }

  if (numLiterals > MAX_NUM_LITERALS) {
    errorf("Maximum number of literals, %d, exceeded: %d.  Extras ignored",
       MAX_NUM_LITERALS, numLiterals);
    numLiterals = MAX_NUM_LITERALS;
    hadError = true;
  }

  methodLiterals = arrayNew(numLiterals);
  for (i = 0; i < numLiterals; i++) {
    arrayAtPut(methodLiterals, i+1, literalVec[i]);
  }

  free(literalVec);

  return (methodLiterals);
}

/*
 *    static void installMethod(selector, primitiveIndex, numArgs, numTemps, literals, byteCodes)
 *
 * Description
 *
 *    Creates a new CompileMethod and installs it in the method dictionary
 *    for the current class.  If the current class does not contain a valid
 *    method dictionary, one is allocated for it.
 *
 * Inputs
 *
 *    selector:
 *        A symbol that the compiled method should be stored under.  This
 *        selector is what will be matched against the message selector
 *        when a message is sent to the class that this method is a part
 *        of.
 *    primitiveIndex:
 *        A C integer for the primitive operation associated with this
 *        method.  0 if no primitive is associated with this method.
 *    numArgs:
 *        A C integer for the number of arguments that this method has.
 *    numTemps:
 *        A C integer for the number of temporaries that this method has.
 *    literals:
 *        An Array of method literals.
 *    byteCodes:
 *        Vector of the bytecodes for the CompiledMethod.
 *
 */
static void installMethod(selector, primitiveIndex, numArgs, numTemps,
              literals, byteCodes)
OOP    selector, literals;
int    primitiveIndex, numArgs, numTemps;
ByteCodes byteCodes;
{
  OOP        method, methodDictionaryOOP;

  if (declareTracing) {
    printf("Class "); printObject(thisClass); printf("\n");
    printf("   "); printSymbol(selector); printf("\n");
  }

  methodDictionaryOOP = validClassMethodDictionary(thisClass);
  method = makeNewMethod(primitiveIndex, numArgs, numTemps, literals,
             byteCodes);
  latestCompiledMethod = method;

  identityDictionaryAtPut(methodDictionaryOOP, selector, method);
  updateMethodCache(selector, thisClass, method);
}

/*
 *    static OOP makeNewMethod(primitiveIndex, numArgs, numTemps, literals, byteCodes)
 *
 * Description
 *
 *    Constructs and returns a new CompiledMethod instance.  It computes the
 *    method header based on its arguments, and on the contents of the
 *    method's byte codes.
 *
 * Inputs
 *
 *    primitiveIndex:
 *        Integer, non-zero indicates that the method has a primitive
 *        method associated with it.  The primitive will be invoked first
 *        when the method is invoked, and only if the primitive signals
 *        failure will the remaining byte codes of the method be
 *        executed.
 *    numArgs:
 *        Number of arguments that the method has.  A C integer.
 *    numTemps:
 *        Number of temporaries that the method has. C integer.
 *    literals:
 *        An Array of method literals that the CompiledMethod should use.
 *    byteCodes:
 *        A vector of byte codes that make up the executable part of the
 *        method.
 *
 * Outputs
 *
 *    A newly allocated CompiledMethod, fully initialized and ready to go.
 */
static OOP makeNewMethod(primitiveIndex, numArgs, numTemps, literals,
             byteCodes)
int    primitiveIndex, numArgs, numTemps;
OOP    literals;
ByteCodes byteCodes;
{
  MethodHeader    header;
  int        newFlags;

  header.intMark = 1;
  header.headerFlag = 0;
  if (primitiveIndex) {
    header.headerFlag = 3;
    if (declareTracing) {
      printf("  Primitive Index %d\n", primitiveIndex);
    }
  }

  header.primitiveIndex = primitiveIndex;
  header.numArgs = numArgs;
  header.numTemps = numTemps;
  header.numLiterals = numLiterals;

  if (primitiveIndex == 0) {
    if (numArgs == 0 && numTemps == 0
    && (newFlags = isSimpleReturn(byteCodes)) != 0) {
      header.headerFlag = newFlags & 0xFF;
      if (header.headerFlag == 2) {
    /* if returning an instance variable, this is indicated in the number
       of temporary variables */
    header.numTemps = newFlags >> 8;
      }
      freeByteCodes(byteCodes);
      byteCodes = nil;
      literals = nilOOP;
    }
  }
  return (methodNew(header, literals, byteCodes));
}

/*
 *    static OOP methodNew(header, literals, byteCodes)
 *
 * Description
 *
 *    Creates and returns a CompiledMethod.  The method is completely filled
 *    in, including the descriptor, the method literals, and the byte codes
 *    for the method.
 *
 * Inputs
 *
 *    header: Header of the method, a Smalltalk Integer.
 *    literals:
 *        A Smalltalk Array of literals that the method should contain.
 *    byteCodes:
 *        The byte code vector for the method.
 *
 * Outputs
 *
 *    A newly created CompiledMethod instance that's completely initialized.
 */
static OOP methodNew(header, literals, byteCodes)
MethodHeader header;
OOP    literals;
ByteCodes byteCodes;
{
  int        numByteCodes, numLiterals, i;
  CompiledMethod method;
  OOP        litOOP, methodOOP;

  if (byteCodes != nil) {
    numByteCodes = byteCodeLength(byteCodes);
  } else {
    numByteCodes = 0;
  }

  method = simpleMethodNew(numByteCodes, header);
  method->descriptor = methodInfoNew();
  maybeMoveOOP(method->descriptor);

  numLiterals = header.numLiterals;

  for (i = 1; i <= numLiterals; i++) {
    litOOP = arrayAt(literals, i);
    maybeMoveOOP(litOOP);
    method->literals[i-1] = litOOP;
  }

  if (byteCodes != nil) {
    copyByteCodes((Byte *)&method->literals[numLiterals], byteCodes);
  }

  if (declareTracing) {
    printByteCodes(byteCodes, method->literals);
  }

  freeByteCodes(byteCodes);

  methodOOP = allocOOP(method);
  methodOOP->flags |= (4 - numByteCodes) & 3;
  return (methodOOP);
}

/*
 *    OOP methodNewOOP(numByteCodes, header)
 *
 * Description
 *
 *    Used to implement the primitive that creates new compiled methods.
 *    Allocates and returns an OOP for a CompiledMethod.
 *
 * Inputs
 *
 *    numByteCodes:
 *        Number of byte codes that the CompiledMethod will contain.
 *    header: The header for the CompiledMethod.  A Smalltalk integer.
 *
 * Outputs
 *
 *    Newly allocated CompiledMethod OOP.
 */
OOP methodNewOOP(numByteCodes, header)
long    numByteCodes;
MethodHeader header;
{
  CompiledMethod method;
  OOP        oop;

  method = simpleMethodNew(numByteCodes, header);
  oop = allocOOP(method);
  /* ### Perhaps this could be a little better abstracted */
  oop->flags |= (4 - numByteCodes) & 3;

  return (oop);
}

/*
 *    static CompiledMethod simpleMethodNew(numByteCodes, header)
 *
 * Description
 *
 *    Creates and returns a compiled method object.  It sets the header of
 *    the compiled method from "header", and allocates the object so that it
 *    can hold "numByteCodes" byte codes.
 *
 * Inputs
 *
 *    numByteCodes:
 *        An integer that is the number of byte codes the compiled method
 *        will contain.
 *    header: The method header to be used.  Used for placing into the
 *        compiled method and for figuring out how many literals the
 *        method has.
 *
 * Outputs
 *
 *    A compiled method object (NOT an OOP!).
 */
static CompiledMethod simpleMethodNew(numByteCodes, header)
long    numByteCodes;
MethodHeader header;
{
  CompiledMethod method;
  int        numBytes, numLiterals;

  numBytes = sizeof(struct CompiledMethodStruct) - sizeof(method->literals);
  numLiterals = 0;

  numLiterals = header.numLiterals;
  numBytes += numLiterals * sizeof(OOP);

  numBytes += numByteCodes;

  method = (CompiledMethod)allocObj(ROUNDED_WORDS(numBytes) << 2);
  method->objSize = ROUNDED_WORDS(numBytes);
  method->objClass = compiledMethodClass;
  method->header = header;

  return (method);
}

/*
 *    Boolean validMethodIndex(methodOOP, index)
 *
 * Description
 *
 *    Returns true if "index" is in the range of valid indices into the
 *    instance variables of CompiledMethod "methodOOP".
 *
 * Inputs
 *
 *    methodOOP:
 *        An instance of CompiledMethod.
 *    index : 1 based integer index into the instance variables of the
 *        method.
 *
 * Outputs
 *
 *    True if "index" is within legal range of indices to the instance
 *    variables of the method.  False otherwise.
 */
Boolean validMethodIndex(methodOOP, index)
OOP    methodOOP;
long    index;
{
  CompiledMethod method;

  method = (CompiledMethod)oopToObj(methodOOP);
  /* Written this way to allow a debugging person to see the return value */
  /* The +2 counts for the description and header */
  if (index >= 1 && index <= method->header.numLiterals + 2) {
    return (true);
  } else {
    return (false);
  }
}

/*
 *    OOP compiledMethodAt(methodOOP, index)
 *
 * Description
 *
 *    Return the object at "index" in CompiledMethod "methodOOP".  Method
 *    literals currently start at index 3.
 *
 * Inputs
 *
 *    methodOOP:
 *        An instance of CompiledMethod.
 *    index : A 1 based integer index into the instance variables of the
 *        method.  The method's descriptor is at index 1, and the method
 *        header is at index 2.
 *
 * Outputs
 *
 *    The object at the given index.
 */
OOP compiledMethodAt(methodOOP, index)
OOP    methodOOP;
long    index;
{
  CompiledMethod method;
  OOP        oop;

  method = (CompiledMethod)oopToObj(methodOOP);
  oop = method->literals[index-3]; /* index==1 => descriptor
                      => literals[index-2-1] */
  return (oop);
}

/*
 *    void compiledMethodAtPut(methodOOP, index, valueOOP)
 *
 * Description
 *
 *    Store "valueOOP" into the instance variable of CompiledMethod
 *    "methodOOP" at "index".
 *
 * Inputs
 *
 *    methodOOP:
 *        A CompiledMethod instance.
 *    index : A 1 based index into the method's instance variables.  Method
 *        literals currently start at index 3; the descriptor is stored
 *        at index 1, and the header is at index 2.
 *    valueOOP:
 *        The object to be stored at the given index.
 *
 */
void compiledMethodAtPut(methodOOP, index, valueOOP)
OOP    methodOOP, valueOOP;
long    index;
{
  CompiledMethod method;

  method = (CompiledMethod)oopToObj(methodOOP);
  prepareToStore(methodOOP, valueOOP);
  method->literals[index-3] = valueOOP; /*index==1 => descriptor
                      => literals[index-2-1] */
}

/*
 *    OOP getMethodDescriptor(methodOOP)
 *
 * Description
 *
 *    Returns the descriptor for the given CompiledMethod.  The descriptor
 *    contains information about which category the method was stored under,
 *    and information that can be used to reconstruct the source code for the
 *    method.
 *
 * Inputs
 *
 *    methodOOP:
 *        OOP of a CompiledMethod instance.
 *
 * Outputs
 *
 *    Descriptor that was stored in the method, normally a MethodInfo
 *    instance.
 */
OOP getMethodDescriptor(methodOOP)
OOP    methodOOP;
{
  CompiledMethod method;

  method = (CompiledMethod)oopToObj(methodOOP);
  return (method->descriptor);
}

/*
 *    void setMethodDescriptor(methodOOP, descriptorOOP)
 *
 * Description
 *
 *    Sets the method descriptor of "methodOOP" to be "descriptorOOP".
 *
 * Inputs
 *
 *    methodOOP:
 *        OOP of a CompiledMethod.
 *    descriptorOOP:
 *        OOP of a MethodInfo instance which contains the descriptor for
 *        the CompiledMethod.
 *
 */
void setMethodDescriptor(methodOOP, descriptorOOP)
OOP    methodOOP, descriptorOOP;
{
  CompiledMethod method;

  method = (CompiledMethod)oopToObj(methodOOP);
  if (GCIsOn()) {
    prepareToStore(methodOOP, descriptorOOP);
  }
  method->descriptor = descriptorOOP;
}

/*
 *    static OOP methodInfoNew()
 *
 * Description
 *
 *    Returns an instance of MethodInfo.  This instance is used in the
 *    reconstruction of the source code for the method, and holds the
 *    category that the method belongs to.
 *
 * Outputs
 *
 *    Instance of MethodInfo used to hold category and source string
 *    information.
 */
static OOP methodInfoNew()
{
  MethodInfo    methodInfo;

  methodInfo = (MethodInfo)newInstance(methodInfoClass);
  methodInfo->sourceCode = fileSegmentNew();
  maybeMoveOOP(methodInfo->sourceCode);
  methodInfo->category = thisCategory;

  return (allocOOP(methodInfo));
}

/*
 *    static OOP fileSegmentNew()
 *
 * Description
 *
 *    Returns a FileSegment instance for the currently open compilation
 *    stream.   FileSegment instances are used record information useful in
 *    obtaining the source code for a method that's been compiled.  Depending
 *    on whether the input stream is a string or a FileStream, the instance
 *    variables are different; for a string, the entire contents of the
 *    string is preserved as the source code for the method; for a disk file,
 *    the file name, byte offset and length are preserved.
 *
 * Outputs
 *
 *    A FileSegment instance that can be used to recover the current method's
 *    source code.
 */
static OOP fileSegmentNew()
{
  OOP        fileName, stringContents;
  FileSegment    fileSegment;
  int        startPos;

  switch (getCurStreamType()) {
  case unknownStreamType:
    return (nilOOP);

  case fileStreamType:
    fileName = getCurFileName();
    fileSegment = (FileSegment)newInstance(fileSegmentClass);
    maybeMoveOOP(fileName);
    fileSegment->fileName = fileName;
    startPos = getMethodStartPos();
    fileSegment->startPos = fromInt(startPos);
    /* The second -1 removes the terminating '!' */
    fileSegment->length = fromInt(getCurFilePos() - startPos - 1 - 1);
    return (allocOOP(fileSegment));

  case stringStreamType:
    stringContents = getCurString();
    return (stringContents);

#ifdef USE_READLINE
  case readlineStreamType:
    stringContents = getCurReadline();
    return (stringContents);
#endif /* USE_READLINE */
  }
}